home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / s_to_z / smtpmail / uucode.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-15  |  8KB  |  344 lines
  1. {.$DEFINE UseBits}
  2. unit UUCode;
  3.  
  4. interface
  5.  
  6. uses Classes,SysUtils,Forms,Dialogs;
  7.  
  8. const
  9.   MaxChars = 45;
  10.  
  11. type
  12.   TCodeMethod = (cdUU,cdXX);
  13.  
  14.   T45Bytes = array[1..MaxChars] of byte;
  15.   T60Bytes = array[1..2*MaxChars] of byte;
  16.   TBuffer = array[1..$FFF0] of byte;
  17. {A special class for bitwise operations}
  18. {$IFDEF UseBits}
  19. T24Bits = class
  20. private
  21.   Bits : array[0..MaxChars] of byte;
  22. public
  23.   procedure SetBit(BitNo : word);
  24.   function BitIsOn(BitNo : word) : boolean;
  25.   procedure Clear;
  26. end;
  27. {$ELSE}
  28.   T24Bits = array[0..8*MaxChars] of boolean;
  29. {$ENDIF}
  30.  
  31. EUUInvalidCharacter = class(Exception)
  32.   constructor Create;
  33. end;
  34.  
  35. TUUCode = class
  36. private
  37.   StringList : TStringList;
  38.   Stream : TStream;
  39.   CurSection : byte;
  40.   A24Bits : T24Bits;
  41.   FCodeMethod : TCodeMethod;
  42.   FCheckSums : boolean;
  43.   FOnProgress : TNotifyEvent;
  44.   FOnStart : TNotifyEvent;
  45.   FOnEnd : TNotifyEvent;
  46.   procedure SetCodeMethod(Value : TCodeMethod);
  47.   function Generate60Bytes(tb : T45Bytes; NumOfBytes : byte) : string;
  48.   procedure Generate45Bytes(InS : string; A45Bytes : pointer;
  49.                             var BytesGenerated : word);
  50.   function ByteFromTable(Ch : Char) : byte;
  51.   procedure DoProgress(Sender : TObject);
  52.   procedure DoStart(Sender : TObject);
  53.   procedure DoEnd(Sender : TObject);
  54. public
  55.   Progress : Integer;
  56.   ProgressStep : Integer;
  57.   Canceled : boolean;
  58.   Table : string;
  59.   constructor Create(AStream : TStream; AStringList : TStringList);
  60. {$IFDEF UseBits}
  61.   destructor Destroy; override;
  62. {$ENDIF}
  63.   procedure Encode;
  64.   procedure Decode;
  65.   property CodeMethod : TCodeMethod read FCodeMethod
  66.                            write SetCodeMethod default cdUU;
  67.   property CheckSums : boolean read FCheckSums write FCheckSums
  68.                            default false;
  69.   property OnProgress : TNotifyEvent read FOnProgress
  70.                            write FOnProgress;
  71.   property OnStart : TNotifyEvent read FOnStart write FOnStart;
  72.   property OnEnd : TNotifyEvent read FOnEnd write FOnEnd;
  73. end;
  74.  
  75. implementation
  76.  
  77. {$IFDEF UseBits}
  78. procedure T24Bits.SetBit(BitNo : word);
  79. var
  80.   i : byte;
  81. begin
  82.   i:=BitNo div 8;
  83.   Bits[i]:=Bits[i] or (1 shl (BitNo mod 8));
  84. end;
  85.  
  86. function T24Bits.BitIsOn(BitNo : word) : boolean;
  87. var
  88.   j : byte;
  89. begin
  90.   j:=BitNo mod 8;
  91.   Result:=Bits[BitNo div 8] and (1 shl j)=1 shl j;
  92. end;
  93.  
  94. procedure T24Bits.Clear;
  95. begin
  96.   FillChar(Bits,SizeOf(Bits),0);
  97. end;
  98. {$ENDIF}
  99.  
  100. constructor EUUInvalidCharacter.Create;
  101. begin
  102.   inherited Create('Invalid character in the input file');
  103. end;
  104.  
  105. {TUUCode}
  106. constructor TUUCode.Create(AStream : TStream; AStringList : TStringList);
  107. begin
  108.   inherited Create;
  109.   Stream:=AStream;
  110.   StringList:=AStringList;
  111.   ProgressStep:=10;
  112.   FCodeMethod:=cdUU;
  113.   Table:='`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
  114.   FCheckSums:=false;
  115. {$IFDEF UseBits}
  116.   A24Bits:=T24Bits.Create;
  117. {$ELSE}
  118.   FillChar(A24Bits,SizeOf(A24Bits),0);
  119. {$ENDIF}
  120. end;
  121.  
  122. {$IFDEF UseBits}
  123. destructor TUUCode.Destroy;
  124. begin
  125.   A24Bits.Free;
  126.   inherited Destroy;
  127. end;
  128. {$ENDIF}
  129.  
  130. procedure TUUCode.SetCodeMethod(Value : TCodeMethod);
  131. begin
  132.   if Value<>FCodeMethod then
  133.   begin
  134.     FCodeMethod:=Value;
  135.     if Value=cdUU then
  136.     begin
  137.       Table:='`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
  138.     end
  139.     else
  140.     begin
  141.       Table:='+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
  142.     end;
  143.   end;
  144. end;
  145.  
  146. procedure TUUCode.DoProgress(Sender : TObject);
  147. begin
  148.   if Assigned(FOnProgress) then
  149.     FOnProgress(Sender);
  150. end;
  151.  
  152. procedure TUUCode.DoStart(Sender : TObject);
  153. begin
  154.   if Assigned(FOnStart) then
  155.     FOnStart(Sender);
  156. end;
  157.  
  158. procedure TUUCode.DoEnd(Sender : TObject);
  159. begin
  160.   if Assigned(FOnEnd) then
  161.     FOnEnd(Sender);
  162. end;
  163.  
  164. function TUUCode.Generate60Bytes(tb : T45Bytes; NumOfBytes : byte) : string;
  165. {Converts 45 bytes of binary data to 60 bytes of text}
  166. var
  167.   i,j,k,b,m : word;
  168.   CheckSum : word;
  169.   s : string;
  170. begin
  171.   k:=0;
  172. {$IFDEF UseBits}
  173.   A24Bits.Clear;
  174. {$ELSE}
  175.   FillChar(A24Bits,SizeOf(T24Bits),0);
  176. {$ENDIF}
  177.   for i:=1 to MaxChars do
  178.   begin
  179.     b:=tb[i];
  180.     for j:=7 DownTo 0 do
  181.     begin
  182.       m:=1 shl j;
  183.       if (b and m = m) then
  184. {$IFDEF UseBits}
  185.         A24Bits.SetBit(k);
  186. {$ELSE}
  187.         A24Bits[k]:=true;
  188. {$ENDIF}
  189.       Inc(k);
  190.     end;
  191.   end;
  192.   s:=''; k:=0; m:=4*(MaxChars div 3);
  193.   CheckSum:=0;
  194.   for i:=1 to m do
  195.   begin
  196.     b:=0;
  197.     for j:=5 DownTo 0 do
  198.     begin
  199. {$IFDEF UseBits}
  200.       if A24Bits.BitIsOn(k) then b:= b or (1 shl j);
  201. {$ELSE}
  202.       if A24Bits[k] then b:= b or (1 shl j);
  203. {$ENDIF}
  204.       Inc(k);
  205.     end;
  206.     s[i]:=Table[b+1];
  207.     if FCheckSums then
  208.       Inc(CheckSum,b);
  209.   end;
  210.   if NumOfBytes=MaxChars then s[0]:=Char(4*MaxChars div 3)
  211.     else s[0]:=Char(4*NumOfBytes div 3 + 1);
  212.   if FCheckSums then
  213.     s:=Concat(s,Table[CheckSum mod 64 + 1]);
  214.   Result:=Concat(Table[NumOfBytes+1],s);
  215. end;
  216.  
  217. procedure TUUCode.Encode;
  218. var
  219.   BytesRead : word;
  220.   A45Bytes : T45Bytes;
  221.   Total : LongInt;
  222. begin
  223.   DoStart(Self);
  224.   StringList.Clear;
  225.   Progress:=0; Total:=0; Canceled:=false;
  226.   try
  227.     repeat
  228.       BytesRead:=Stream.Read(A45Bytes,MaxChars);
  229.       Inc(Total,BytesRead);
  230.       StringList.Add(Generate60Bytes(A45Bytes,BytesRead));
  231.       Progress:=100*Total div Stream.Size;
  232.       if Progress mod ProgressStep = 0 then
  233.          DoProgress(Self);
  234.       Application.ProcessMessages;
  235.     until (BytesRead<MaxChars) or Canceled;
  236.   finally
  237.     Progress:=100;
  238.     DoProgress(Self);
  239.     if Canceled then StringList.Clear;
  240.     DoEnd(Self);
  241.   end;
  242. end;
  243.  
  244. function TUUCode.ByteFromTable(Ch : Char) : byte;
  245. var
  246.   i : byte;
  247. begin
  248.   i:=1;
  249.   while (Ch<>Table[i]) and (i<=64) do Inc(i);
  250.   if i>64 then
  251.   begin
  252.     if Ch=' ' then Result:=0
  253.       else raise EUUInvalidCharacter.Create;
  254.   end;
  255.   Result:=i-1;
  256. end;
  257.  
  258. procedure TUUCode.Generate45Bytes(InS : string; A45Bytes : pointer;
  259.                           var BytesGenerated : word);
  260. {converts 60 bytes of text to 45 bytes of binary data}
  261. var
  262.   i,j,k,b,m : word;
  263.   InSLen : byte absolute InS;
  264.   ActualLen : byte;
  265. begin
  266.   FillChar(A45Bytes^,MaxChars,0);
  267. {$IFDEF UseBits}
  268.   A24Bits.Clear;
  269. {$ELSE}
  270.   FillChar(A24Bits,SizeOf(T24Bits),0);
  271. {$ENDIF}
  272.   k:=0;
  273.   ActualLen:=4*ByteFromTable(InS[1]) div 3;
  274.   if ActualLen<>(4*MaxChars div 3) then
  275.     ActualLen:=InSLen-1;
  276.   for i:=2 to ActualLen+1 do
  277.   begin
  278.     b:=ByteFromTable(InS[i]);
  279.     for j:=5 DownTo 0 do
  280.     begin
  281.       m:=1 shl j;
  282.       if (b and m = m) then
  283. {$IFDEF UseBits}
  284.         A24Bits.SetBit(k);
  285. {$ELSE}
  286.         A24Bits[k]:=true;
  287. {$ENDIF}
  288.       Inc(k);
  289.     end;
  290.   end;
  291.   k:=0;
  292.   for i:=1 to MaxChars do
  293.   begin
  294.     b:=0;
  295.     for j:=7 DownTo 0 do
  296.     begin
  297. {$IFDEF UseBits}
  298.       if A24Bits.BitIsOn(k) then b:= b or (1 shl j);
  299. {$ELSE}
  300.       if A24Bits[k] then b:= b or (1 shl j);
  301. {$ENDIF}
  302.       Inc(k);
  303.     end;
  304.     TBuffer(A45Bytes^)[i]:=b;
  305.   end;
  306.   BytesGenerated:=ByteFromTable(InS[1]);
  307. end;
  308.  
  309. procedure TUUCode.Decode;
  310. var
  311.   A45Bytes : T45Bytes;
  312.   BytesGenerated : word;
  313.   i : LongInt;
  314.   s : string;
  315.   p : pointer;
  316. begin
  317.   DoStart(Self);
  318.   Progress:=0;
  319.   Canceled:=false;
  320.   try
  321.     GetMem(p,MaxChars);
  322.     i:=0;
  323.     repeat
  324.       s:=StringList.Strings[i];
  325.       Generate45Bytes(s,p,BytesGenerated);
  326.       Stream.Write(p^,BytesGenerated);
  327.       Progress:=(100*i) div (StringList.Count-1);
  328.       if Progress mod ProgressStep = 0 then
  329.          DoProgress(Self);
  330.       Application.ProcessMessages;
  331.       if Canceled then break;
  332.       Inc(i);
  333.     until (i=StringList.Count) or (StringList[i]='end')
  334.             or (StringList[i]=Table[1]);
  335.   finally
  336.     Progress:=100;
  337.     DoProgress(Self);
  338.     FreeMem(p,MaxChars);
  339.     DoEnd(Self);
  340.   end;
  341. end;
  342.  
  343. end.
  344.